The X-Philes (2nd Revision)/The X-Philes Number 1 (1995).iso/xphiles/hp48hor1/phone.src

Text File | 1991-01-23 | 23KB | 624 lines

%%HP: T(3)A(R)F(.);
\<<  @ Start of Program @
@ PHONE V1.4 by Joe Ervin.  18-JAN-1991 @
@ NEW FEATURES FOR V1.4.
@ Added handling of addresses, in addition to names and numbers.
@ Included YN menu definition, rather than using an external reference.
@ Added RCLF and STOF to preserve the state of the system.  Also enforce
@ STD display mode during execution.  Ensures a nice display during PHSEARCH.
@
@ NEW FEATURES FOR V1.3.
@ Added a PREV menu choice in the PHSEARCH routine to allow the user to
@ move backwards through the list of matches.

CLEAR
{} @ Dummy value to hold place for PHNAMES. @
{} @ Dummy value to hold place for PHNUMBERS. @
{}
0
0
\-> PHNAMES PHNUMBERS ADDRESSES PHSIZE FLAGS
   @ Creates local storage for names and numbers. @

\<< @ Surounds the procedures as well as main routine. @

\<<  @Start definition of PHSEARCH routine.@
CLEAR

0 0 0 {} 0


\->
        SRCHNAME  @ Local variable to hold the search name. @
        DONE      @ Local variable to detect when search has finished. @
        MATCHNUM  @ Local variable to store the number of matches.  @
        MATCHLIST     @ Stores list of matches. @
        MATCHINDEX    @ Used to index into the match list. @


@ What we are going to do now is to step through each name in the list, and @
@ for each name, we will do a pattern match of the search name within each@
@ name in the list. If the searchname is found within a given name, then @
@ the index corresponding to the matched name will be added to MATCHLIST. @
@ This routine uses flag 1 to indicate success or failure to the calling @
@ routine. (SET = success, CLEAR = failure - i.e. no matches.  @
@ Flag 2 is also used to indicate whether the main routine should exit @
@ or prompt the user for another choice whether to search or edit the @
@ phone list. @

\<< @This delimiter surrounds PHSEARCH's local variables@
@ The following are definitions for four different menus which
@ are used by the PHSEARCH facility.  These definitions are defined
@ here as local variables for reasons of performace;  it ran
@ kinda slow when I built these menus in real time.  Defining them
@ here and then just calling them speeds things up considerably.

@ Here is the menu definition for MENADR @
        {{"Next" \<< CONT \>> } {"Prev" \<<  \-> X
        \<< CASE
        'X==1'
          THEN
            IF 'MATCHNUM>1' @ Do nothing if only 1 match.
            THEN
              'MATCHNUM-1' EVAL CONT
            ELSE X CONT
            END
          END
        'X==2' THEN MATCHNUM CONT END @ So next index will be 1.
        'X-2' EVAL CONT  @ Do this by default to back up one index.
        END  \>>  @ end of case statement 1.
        \>> }
        {} { "Addr" \<< 6 SF \-> X
        \<< CASE
        'X==1' THEN IF 'MATCHNUM>1' @ Do nothing if only 1 match.
          THEN
            'MATCHNUM' EVAL CONT
          ELSE X CONT
          END
        END
        'X-1' EVAL CONT @ Do this by default to replay last index.
        END \>> @ end of case statement 2.
        \>>}
        {} {"Exit"
        \<< 1 'DONE' STO CONT \>>} }

@ Here is the menu definition for MENNUM
        {{"Next" \<< CONT \>> } {"Prev" \<<  \-> X
        \<< CASE
          'X==1' THEN IF 'MATCHNUM>1' @ Do nothing if only 1 match.
          THEN
            'MATCHNUM-1' EVAL CONT
          ELSE X CONT
          END
        END
        @So next index will be MATCHNUM.
        'X==2' THEN MATCHNUM CONT END @ So next index will be 1.
        'X-2' EVAL CONT @ Do this by default to back up one index.
        END \>> @ end of case statement 3.
        \>> }
        {} { "Num" \<< 6 CF \-> X
        \<< CASE
        'X==1' THEN IF 'MATCHNUM>1' @ Do nothing if only 1 match.
          THEN
            'MATCHNUM' EVAL CONT
          ELSE X CONT
          END
        END
        'X-1' EVAL CONT @ Do this by default to replay last index.
        END \>> @ end of case statement 4.
        \>> } {} {"Exit"
        \<< 1 'DONE' STO CONT \>>} }

@ Here is the menu definition for MENPICKADR
        {{"Next" \<< CONT \>> } {"Prev" \<<  \-> X
        \<< CASE
          'X==1' THEN IF 'MATCHNUM>1' @ Do nothing if only 1 match.
          THEN
            'MATCHNUM-1' EVAL CONT
          ELSE X CONT
          END
        END
        'X==2' THEN MATCHNUM CONT END @ So next index will be 1.
        'X-2' EVAL CONT @ Do this by default to back up one index.
        END \>> @ end of case statement 5.
        \>> }
        {"Pick"
        \<<IF DUP 1 == THEN DROP MATCHNUM ELSE 1 - END GET 1 'DONE' STO
        4 CF CONT \>>}
        { "Addr" \<< 6 SF \-> X
        \<< CASE
        'X==1' THEN IF 'MATCHNUM>1' @ Do nothing if only 1 match.
          THEN
            'MATCHNUM' EVAL CONT
          ELSE X CONT
          END
        END
        'X-1' EVAL CONT @ Do this by default to replay last index.
        END \>> @ end of case statement 6.
        \>>}
        {} {"Exit"
        \<< 1 'DONE' STO 1 CF 2 SF CONT \>>} }


@ Here is the menu definition for MENPICKNUM
        {{"Next" \<< CONT \>> } {"Prev" \<<  \-> X
        \<< CASE
          'X==1' THEN IF 'MATCHNUM>1' @ Do nothing if only 1 match.
          THEN
            'MATCHNUM-1' EVAL CONT
          ELSE X CONT
          END
        END
        'X==2' THEN MATCHNUM CONT END @ So next index will be 1.
        'X-2' EVAL CONT @ Do this by default to back up one index.
        END \>> @ end of case statement 7.
        \>> }
        {"Pick"
        \<<IF DUP 1 == THEN DROP MATCHNUM ELSE 1 - END GET 1 'DONE' STO
        4 CF CONT \>>}
        { "Num" \<< 6 CF \-> X
        \<< CASE
        'X==1' THEN IF 'MATCHNUM>1' @ Do nothing if only 1 match.
          THEN
            'MATCHNUM' EVAL CONT
          ELSE X CONT
          END
        END
        'X-1' EVAL CONT @ Do this by default to replay last index.
        END \>> @ end of case statement 8.
        \>> } {} {"Exit"
        \<< 1 'DONE' STO 1 CF 2 SF CONT \>>} }

\->     MENADR       @ Menu definitions used within PHSEARCH.
        MENNUM
        MENPICKADR
        MENPICKNUM


\<< @ This delimeter surrounds the defining procedure for the above
    @ menu definitions.

{} TMENU  @ Just to clear the menu from the main routine. @
"Enter name..." {":Name:" \Ga} INPUT @Prompt user for name to search.@

IF DUP SIZE 6 \<=   @ If no name was entered. @
THEN
 1 SF  @ To indicate successfull completion of search routine. @
 2 SF  @ To cause the calling routine to ask again: SEARCH or EDIT.  @
 4 CF @ Just in case this routine was called from PHEDIT. @
ELSE
  DUP SIZE 7 SWAP SUB 'SRCHNAME' STO
  PHNAMES  OBJ\->@ Puts the list of names on the stack.@
  IF SRCHNAME "*" SAME THEN 3 SF END
  1 SWAP FOR I  @ Step through the whole list of names. @
    SRCHNAME  @ Put the string to search for on the stack. @
    IF POS 3 FS? OR
    @ If SRCHNAME exists anywhere within the name...@
    THEN
      'MATCHNUM'  INCR DROP @ Add one to the number of matches. @
      'PHSIZE - I + 1' EVAL
      'MATCHLIST' STO+  @ Add the match index to list of match indices. @
    END  @ End this match check. @
  NEXT   @ End loop checking for matches. @
  3 CF

  IF MATCHNUM 0 \=/   @ IF there were at least some matches...@
  THEN
    1 SF  2 CF   @ To indicate success to the calling routine. @
    MATCHLIST
    1  @ To initialize index into matchlist. @
    DO   @ Display list of matches until done. @
      GETI  @ Fetch the next item pointed to by the matchindex. @
      'MATCHINDEX' STO DUP
      IF 1 == THEN MATCHNUM ELSE DUP 1 - END
      @ Now display which match we are looking at. @
      CLLCD
      "Match " SWAP + " of "  + MATCHNUM +
      1 DISP
      ":Name:" PHNAMES MATCHINDEX GET +
      @ Concatenates label to name. @
      "
"
      +  @ Adds a LF to the end of the NAME string.
      IF 6 FC? @ If we are in "numbers" mode...
      THEN
        ":Number:" PHNUMBERS MATCHINDEX GET +
        @ Concatenates label to number. @
        + @ Concatenates the NUMBER string to the NAME string.
        4 DISP
      ELSE
        "
"
        ADDRESSES MATCHINDEX GET +
        @ Concatenates label to address. @
        + @ Concatenates the ADDRESS string to the NAME string.
        3 DISP
      END
      3 FREEZE

@ Now we need to call in the proper menu definition depending on what
@ display mode we are in (flag 6) and whether PHSEARCH was called from
@ PHEDIT or from the main routine.
      IF 4 FC?  @ PHSEARCH was called from main routine.
      THEN
        IF 6 FC? @ If in "numbers" mode...
        THEN  @ We need to add a menu item to switch to "addresses" mode.
          MENADR
        ELSE  @ We are in "address" mode...
          MENNUM
        END
      ELSE  @ PHSEARCH was called from PHEDIT.
        IF 6 FC? @ If in "numbers" mode...
        THEN  @ We need to add a menu item to switch to "addresses" mode.
          MENPICKADR
        ELSE     @ We are in "address" mode...
          MENPICKNUM
        END
      END

      TMENU HALT  @ Display the menu and stop for input.
    UNTIL DONE
    END
  ELSE  @  If there were no matches...@
    "The specified name
was not found" @ To indicate search failure. @
    1 CF 2 CF @ To indicate failure to the calling routine. @
    CLLCD 1200 .1 BEEP 2 DISP 1 WAIT
  END
END
\>> @ This delimeter surrounds the defining procedure for the
    @ menu definitions.

\>>
\>> @Ends definition of PHSEARCH routine.@

\-> PHSEARCH @ Creates the subroutine PHSEARCH. @
\<<
\<< @ Definition of the PHEDIT routine starts here. @
\-> P1 @ Take the parameter passed in on the stack. @
\<< IF P1 "INT" SAME
THEN

@ At this point, the local variables "PHNAMES" and "PHNUMBERS" contain the @
@ names and numbers of the list to be edited.  Now we need to present the @
@ user with a meaningful display from which to choose actions.  The actions @
@ allowed include "MODIFY" and "ADD".  The following code prompts the user @
@ to choose between these two options, and then performs the simple editing @
@ function. @

    "Do you want to add
to the list, modify
an existing entry,
or delete an entry?"
    CLLCD 1 DISP 3
    FREEZE {{"Add" \<<"ADD" CONT\>>} {"Mdfy" \<<"MODIFY" 5 CF CONT\>>}
    {"Del"  \<<"MODIFY" 5 SF CONT \>>} {} {}
    {"EXIT" \<<2 SF CONT\>>}} TMENU HALT

ELSE CLEAR "ADD" @ This is for when PHEDIT was called by main with @
                 @ P1 of "NEW". @
END

@ This is for the case when PHEDIT was called by the main routine for  @
@ the case where there was no phone list. @

IF 2 FC?C
THEN

{} TMENU  @ Clear the menu from what was previously there. @
0 0 0 0 \-> X TEMP LEN LEN2 DONE
\<< CASE
@ Note the creation of the scratch variables 'TEMP', 'LEN', 'LEN2'.@
@ 'TEMP' is scratch for the name, LEN is scratch for the name's length, @
@ and 'LEN2' is scratch for the length of the phone number. @
@ DONE is used for the repeat loop. @
@ X gets the "ADD" or "MODIFY" string from the above prompt. @

  X "ADD" SAME @ Here we are adding to the list of names. @
      THEN
      DO
        "Enter name..." {":Name:" \Ga} INPUT
        @ Prompts the user to enter the name for this entry. @
        @ Now we need to build up the command line for the INPUT command @
        @ which will pull in the number for this entry.  We want to @
        @ display the name above where the user is going to enter the @
        @ number. @
        DUP SIZE 'LEN' STO 'TEMP' STO
        IF LEN 6 >
        THEN
          "Enter number..." TEMP EVAL "
:Number:" + { 2 9 }
          \Ga 3 \->LIST INPUT

          @ The current prompt shows the name and prompts for @
          @ the phone number. @

          @ Now save the new information and update PHSIZE.
          DUP DUP SIZE 'LEN2' STO 7 LEN SUB PHNAMES + 'PHNAMES' STO
          LEN 10 +
          LEN2 SUB PHNUMBERS + 'PHNUMBERS' STO
          PHNAMES SIZE 'PHSIZE' STO

          @ Now we need to prompt for the address information...
          "Enter address..." TEMP EVAL "
:Addr:" + { 2 7 }
          \Ga 3 \->LIST INPUT

          @ The current prompt shows the name and prompts for @
          @ the address. @

          @ Now save the new ADDRESS information.
          DUP SIZE 'LEN2' STO
          LEN 8 +
          LEN2 SUB ADDRESSES + 'ADDRESSES' STO

        ELSE
          1 'DONE' STO
        END
      UNTIL DONE
      END
    END  @"ADD"@

    X "MODIFY" SAME
      THEN         @ User wants to edit the list @

      CLEAR
      0 0 ""  \-> INDEX  @ Stores the index of the entry to be edited. @
                DONE     @ Used to terminate DO UNTIL loop. @
                EDITSTRING   @ Stores the modified string. @

\<<
      @ Basically what I want to do here is to call the PHSEARCH routine @
      @ in a way that it will get the user to pick a specific entry.  @
      @ I want to use the PHSEARCH routine to do this since so much of @
      @ the code needed to do this is alread done.  The result of the @
      @ PHSEARCH routine is to return an index indicating the exact @
      @ entry which is to be edited.  This routine then needs only @
      @ display it in an input statement in such a way that the user @
      @ can modify it as it sits on the display.  When the user presses @
      @ ENTER, the modified entries (name and number) will be written @
      @ back into the database. @
      @ This routine also checks flag 5 to determine whether the user @
      @ wants to delete the record or simply modify it. @

      DO
        2 CF 4 SF PHSEARCH EVAL @ Get the index of entry to be modified. @
      UNTIL 1 FS?C @ Repeat search routine until user selects an entry @
                   @ or gives up. @
      END
      4 CF   @ Flag 4 was set only to indicate to PHSEARCH to use "pick" in @
                @ the menu so user could choose the item to edit.
      IF 2 FC?C  @ If flag 2 is set, then the user must have given up @
                 @ trying to select an entry to edit. @
      THEN  @ Let's edit the selected entry @
      'INDEX' STO
        IF 5 FC?C
        THEN
          DO
  @ This section of code was modified in v1.4 to handle the editing of
  @ addresses.  For this reason, I use several IFTE commands below to
  @ differentiate between editing the PHNUMBERS field and the
  @ ADDRESSES field.

            INDEX DUP
            PHNAMES SWAP GET @ Gets the name to be modified. @
            SWAP
            6 FC? 'PHNUMBERS' 'ADDRESSES' IFTE
            @ Gets PHNUMBERS or ADDRESSES, depending on the
            @ state of flag 6.

            SWAP GET   @ Gets number/address to be modified. @

            @ The stack now has
            @           2: name
            @           1: number/addr

            @ Now reformat the information for the INPUT command.

            6 FC? ":Number:" ":Addr:" IFTE
            SWAP +
            SWAP ":Name:" SWAP +   @ Adds tags to the name and num/addr.
            "
"
            + SWAP +  @ Creates one long string with a carraige return @
            @ to separate the name and num/addr strings. @


            @ Now display this information using INPUT so the user can @
            @ edit the strings. @


            "Edit entry..."  SWAP 0
            2 \->LIST {} TMENU INPUT

            @ At this point, the user has been prompted with the name and @
            @ number to be modified.  The keyboard is in overstrike mode @
            @ and the cursor was left at the end of the number. @

            @ Now we must recover the new name and number from the @
            @ string on the stack. @

            DUP 'EDITSTRING' STO   @ Save a copy of the string.
            IF DUP ":Name:" POS 1 ==   @ Test for existence of the name...
            SWAP DUP
            6 FC? ":Number:" ":Addr:" IFTE
            POS                   @ ...and number tags within the string.
            DUP 'TEMP' STO  @ Save location of num/addr tag.
            ROT AND
            THEN    @ The user entered valid data. @

              @ Update the database with new name.@
              DUP 7 TEMP 2 - SUB @ Extract the modified name. @
              1 \->LIST PHNAMES SWAP INDEX SWAP REPL
              'PHNAMES' STO    @ Save modified name in PHNAMES.

              @ Update the database with the new number/address.
              TEMP
              6 FC? 8 6 IFTE
              + EDITSTRING SIZE SUB @ Extract the new name/addr.
              1 \->LIST
              6 FC? 'PHNUMBERS' 'ADDRESSES' IFTE
              SWAP INDEX SWAP REPL
              6 FC? "'PHNUMBERS'" "'ADDRESSES'" IFTE
              OBJ\-> STO

              1 'DONE' STO
              CLEAR
            ELSE CLLCD 1200 .1 BEEP "Invalid Entry" 2 DISP 2 WAIT
            END
          UNTIL DONE
          END
        ELSE    @ The user wants to delete the entry.  @
          CLEAR INDEX DUP
          PHNAMES SWAP GET @ Gets the name to be modified. @
          SWAP PHNUMBERS SWAP GET   @ Gets number to be modified. @

          @ The stack now has           @
          @                   2: name   @
          @                   1: number @

          @ Now reformat the information for the INPUT command. @

          ":Number:" SWAP +
          SWAP ":Name:" SWAP +   @ Adds tags to the name and number. @
          "
"
          + SWAP +  @ Creates one long string with a carraige return @
          @ to separate the name and number strings. @


          @ Now display this information and prompt user to verify that @
          @ this record should be deleted.

          CLLCD  "Delete entry?"  1 DISP
          4 DISP 1200 .1 BEEP 3 FREEZE
          { { "Yes" \<< 1 CONT \>> } { } { } { } { }
          { "No" \<< 0 CONT \>> } }
          TMENU HALT
          IF   @ yes @
          THEN
            PHNAMES  OBJ\->  DROP @ Put the list of names on the stack. @
            PHSIZE INDEX 1 - - ROLL
            DROP   @ Deletes the entry pointed to by INDEX. @
            PHSIZE 1 - \->LIST 'PHNAMES' STO

            PHNUMBERS  OBJ\->  DROP @ Put the list of names on the stack. @
            PHSIZE INDEX 1 - - ROLL
            DROP  @ Deletes the entry pointed to by INDEX. @
            PHSIZE 1 - \->LIST 'PHNUMBERS' STO

            ADDRESSES  OBJ\->  DROP @ Put the list of names on the stack. @
            PHSIZE INDEX 1 - - ROLL
            DROP  @ Deletes the entry pointed to by INDEX. @
            'PHSIZE'  DECR \->LIST 'ADDRESSES' STO
          END
        END
      ELSE 5 CF
      END
\>>
    END
  END
\>>    @end case@
END  @IF 2 FC?C

ADDRESSES PHNUMBERS PHNAMES 3 \->LIST 'PHDAT' STO


\>> @ Surrounds PHEDIT's parameters. @
\>> @ Ends the definition of PHEDIT and pushes PHEDIT on the stack @
    @ to be defined later.@





 \-> PHEDIT @ Defines the subroutine "PHEDIT", which edits the database. @
           @ PHEDIT takes as parameters a single string which must have the @
           @ value "NEW", indicating a new list should be created, @
           @ or "INT", indicating the old list should be prompted as to
           @ whether the current list is to be added to or edited. @

\<< @ The main routine starts here. @
64 STWS  @ Sets the word size to 64.  Needed for RCLF
RCLF DUP 'FLAGS' STO
2 {#0d} REPL STOF  @ Clear user flags.
STD  @ Set display to STD mode.  Looks nicer.
IF 'PHDAT' VTYPE -1 ==
  THEN
  CLLCD
  "Phone Database does" 2 DISP "not exist.  Do you"
  3 DISP "want to create it?"
  4 DISP 3 FREEZE
  { { "Yes" \<< 1 CONT \>> } { } { } { } { }
  { "No" \<< 0 CONT \>> } }
  TMENU HALT  @ Prompt the user for yes/no @
  IF
    THEN
    {} DUP 'PHNAMES' STO 'PHNUMBERS' STO
    "NEW" PHEDIT  EVAL @ tells PHEDIT to go directly to the @
                             @ edit input mode on a new list @
  @ After the user exits PHEDIT, control falls down to main routine below.@
    ELSE

"You must create a
phone database before
any further action can
be taken."
      2 DISP CLEAR 2 MENU  1200 .1 BEEP 3 FREEZE  3 WAIT
      0 DOERR         @ Obviously, the user is a pinhead. @
    END

  END

@ We need to start the main routine.@
0 \-> DONE \<<
  @ First we need to suck in the database. @
     {} DUP 'PHNAMES' STO 'PHNUMBERS' STO
  CLEAR  @ Clear the stack, so the following DEPTH command will work.
  PHDAT EVAL

@ At this point, we need to determine if the current database is in
@ the new format used with V1.4 and later.  If the database does not
@ contain the list of ADDRESSES, then we need to add them and write it back
@ out.
  IF  DEPTH 2 ==
  THEN @ We must update the database structure.
    CLLCD "Reformating PHDAT.
Please wait..." 2 DISP 1 WAIT
    DUP @ Create a spare copy of PHNAMES.
    {}  @ Put a null list on the stack.
    SWAP SIZE 1 SWAP FOR I "" + NEXT  @ Creates a list of null strings.
    3 ROLLD 3 \->LIST
    'PHDAT' STO @ Adds the empty address list to the database.
    CLEAR PHDAT EVAL
  END

  'PHNAMES' STO  'PHNUMBERS' STO @ copies the database in the local  @
                                 @ variables 'PHNAMES' , 'PHNUMBERS' @
  'ADDRESSES' STO                @ and 'ADDRESSES'.
  PHNAMES SIZE 'PHSIZE' STO  @ Indicates the number of names in the list. @

  DO
  @ Here we want to ask the user whether we are searching or editing. @
"Do you want to
search the list or
edit the list?"
  CLLCD 1 DISP 3 FREEZE
  {{"SRCH" \<< DO PHSEARCH EVAL UNTIL 1 FS?C END CONT \>>}
  {"EDIT" \<< "INT" PHEDIT  EVAL CONT \>>}
  {}
  {} {} {"Exit" \<<1 'DONE' STO CONT \>>}} TMENU HALT
  @ "INT" for PHEDIT here to tell PHEDIT to prompt the user as to @
  @ whether he wants to edit (modify) the phone list or simply add to it. @

  UNTIL DONE @ Keep on doing this loop until DONE. @
  END
  \>> @ DO @

  CLEAR 2 MENU
  FLAGS STOF  @ Resets the state of the system and user flags.
\>> @ Defines bounds for which PHSEARCH is defined.
\>> @ Main Routine.
\>> @ Main routine and procedures.
\>> @ End of Program.